perm filename LOOP.FAI[NEW,LCS]23 blob
sn#403121 filedate 1978-12-07 generic text, type T, neo UTF8
00100 TITLE LOOP ; SUBROUTINE LOOP(I,J,L,M,N)
00200 ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO,RNX,RCURVE
00300 ENTRY SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,CODN,FSCAN,NALF,BOX,PARCH
00400 ENTRY RJED,RJED2,EDX,EQUAL,BOXX
00500
00600 EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM,RNW,YED
00700 EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ,HOMX,LIMIT,IDEV
00800 EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE,DPTR,ALOG,JCHAR
00900 MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
01000 RC←14 ↔ NX←15 ;**** AC'S 0,1,2,3,5 ARE USED IN 'PLACE' & 'FINDIT'!!
01100 ; DIMENSION N(1)
01200 LOOP: 0 ; DO 1 NN=I+L,J+L,K
01300 MOVE 1,@4(16)
01400 SUB 1,@3(16) ; MM IS IN 1
01500 MOVE 2,@(16)
01600 ADD 2,@3(16) ;I+L -- NN, 1ST TIME
01700 MOVE 3,@1(16)
01800 ADD 3,@3(16) ;J+L
01900 HRRZI 5,@5(16) ; ADR. OF N
02000 ADDI 2,-1(5) ; N(NN)
02100 ADDI 3,-1(5)
02200 MOVE 4,@2(16) ;K
02300 JUMPL 4,LP3 ; JUMP IF NEG. INCR.
02400 HRRM 1,.+1 ; ADD IN MM
02500 LP1: MOVE 6,(2)
02600 MOVEM 6,(2) ;N(NN)=N(NN+MM)
02700 CAIGE 2,(3)
02800 AOJA 2,LP1
02900 JRA 16,6(16)
03000 LP3: HRRM 1,.+1
03100 LP2: MOVE 6,(2) ;NEG. INCR.
03200 MOVEM 6,(2)
03300 CAILE 2,(3)
03400 SOJA 2,LP2
03500 JRA 16,6(16) ; END
03600
03700 PLACE: 0 ; FUNCTION PLACE(X)
03800 ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
03900 ; EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04000 MOVN 2,@(16) ; PLACE=R11-ABS(RD-X)
04100 FADR 2,RMOD+=9 ;END
04200 MOVMS 2
04300 MOVE 0,.COMM.+=12 ;R11
04400 FSBR 0,2
04500 JRA 16,1(16)
04600
04700 FINDIT: 0 ; FUNCTION FINDIT(N)
04800 SETZ ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
04900 HRRZ 1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05000 ;; HRRZI 2,PTR ; FINDIT=0
05100 ;; ADDI 1,(2) ; L=PWDS(N)
05200 ;; MOVE 2,-1(1) ; IF(RN(L+1).NE.1)GO TO 377
05300 ;; FIXX(2) ; IF(RN(L+2).EQ.R2)RETURN
05400 ;; HRRZI 3,XRN ;377 FINDIT=-1
05500 ;; ADDI 3,(2) ; END
05600 MOVE 2,PTR-1(1) ;THESE 3 REPLACE ABOVE
05700 MOVE 5,XRN(2)
05800 CAME 5,[1.0]
05900 JRST FNEG
06000 MOVEM 2,LIMIT+2 ; SENDS BACK A NUM IN L
06100 MOVE 5,XRN+1(2)
06200 CAME 5,.COMM.
06300 FNEG: SETO
06400 JRA 16,1(16)
06500
06600 DPYNEW: 0 ; SUBROUTINE DPYNEW
06700 JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
06800 JUMP [1] ; CALL ACCPOG(1)
06900 MOVE 2,DPY+=4001 ; IF(IGO.GT.0)RETURN
07000 JUMPG 2,DB ; CALL DPYOUT(1)
07100 JSA 16,DPYOUT ; END
07200 JUMP [1]
07300 DB: JRA 16,(16)
07400
07500 MVBEAM: 0 ;C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
07600 HRRZ 2,(16) ; SUBROUTINE MVBEAM(R,I,JY,L,W)
07700 ADD 2,@1(16) ; +I
07800 MOVE 3,2 ;C L AND JY ARE FOR MOVES TO DIFF. STAFF.
07900 ADD 2,@2(16) ; +JY DIMENSION R(1)
08000 MOVE 2,-1(2) ; Y=R(JY+I)
08100 ; Z=ABS(Y)
08200 ; IF(Z.LT.100.)GO TO 1
08300 ; IF(I.GT.5)GO TO 1
08400 ;C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
08500 ; Y=AMOD(Y,100.)
08600 ; Z=Z-ABS(Y)+ABS(X)
08700 ; IF(X)Z=-Z
08800 ; GO TO 2
08900 FADR 2,@4(16) ;1 Z=Y+W
09000 ADD 3,@3(16) ; +L
09100 MOVEM 2,-1(3) ; PUT IT IN R(L+I)
09200 JRA 16,5(16) ; END
09300
09400 MVBX: 0 ; SUBROUTINE MVBX(I)
09500 ; COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
09600 HRRZI 1,XRN ; LOC OF XRN
09700 ADD 1,@(16) ; EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
09800 MOVE 2,1
09900 ADD 2,KJY+1 ; R(L+I)=R8+(R(JY+I)-R4)*RDIS
10000 MOVE 3,-1(2)
10100 FSBR 3,.COMM.+5
10200 FMPR 3,.COMM.+=25 ; *RDIS
10300 FADR 3,.COMM.+=9 ; +R8
10400 ADD 1,.COMM.+=24 ; + L
10500 MOVEM 3,-1(1)
10600 JRA 16,1(16)
10700
10800 JUGGLE: 0 ; SUBROUTINE JUGGLE
10900 ; IMPLICIT INTEGER(A-Z)
11000 ; REAL PWDS,RN
11100 ; COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
11200 ; COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
11300 SOS LIMIT+1 ;ITEM=ITEM-1
11400 HRRZI 15,XRN ; JX=RN(MEDIT)+3 WD CNT OF OLD ITEM
11500 ADD 15,DPY+=4000 ;C I-IX IS WD CNT OF NEW ITEM
11600 KIFIX 14,-1(15) ;MOVE 14,-1(15)
11700 ADDI 14,3 ; JX
11800 MOVE 13,LIMIT+4 ;JY=IX
11900 MOVE 11,LIMIT+3 ; I
12000 SUB 11,13
12100 SUB 11,14 ;Z=I-IX-JX SPACE CHANGE
12200 JUMPL 11,J2751 ;IF(Z)2751,172,751
12300 JUMPE 11,J172
12400 MOVE 5,LIMIT+3 ;751 CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
12500 SUBI 5,1
12600 MOVE 10,DPY+=4000
12700 ADD 10,14
12800 JSA 16,LOOP
12900 JUMP 5
13000 JUMP 10
13100 JUMP [-1]
13200 JUMP 11
13300 JUMP [0]
13400 JUMP XRN
13500 ADD 13,11 ;JY=IX+Z
13600 JRST J172 ;GO TO 172
13700 J2751: ADD 14,DPY+=4000 ;2751 CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
13800 ADD 14,11
13900 MOVE 5,11
14000 ADD 5,LIMIT+4
14100 SOJ 5,
14200 MOVN 10,11
14300 JSA 16,LOOP
14400 JUMP 14
14500 JUMP 5
14600 JUMP [1]
14700 JUMP [0]
14800 JUMP 10
14900 JUMP XRN
15000 ;172 J=RN(JY)+2
15100 J172: KIFIX 12,XRN-1(13) ;MOVE 12,XRN-1(13)
15200 ADDI 12,2 ; J IS IN 12
15300 JSA 16,LOOP ;CALL LOOP(0,J,1,MEDIT,JY,RN)
15400 JUMP [0]
15500 JUMP 12
15600 JUMP [1]
15700 JUMP DPY+=4000 ; MEDIT
15800 JUMP 13 ; JY
15900 JUMP XRN
16000 MOVE 12,LIMIT+4 ; I=IX+Z
16100 ADD 12,11 ; Z IS IN 11
16200 MOVEM 12,LIMIT+3
16300 MOVE 12,LIMIT+1 ; 1751 X=ITEM+1
16400 AOJ 12, ; X IS IN 12
16500 HRRZI 13,DPTR ; JX=WDS(X22+1)-WDS(X22)
16600 ADD 13,DL
16700 MOVE 14,(13) ; WDS(X22+1) IN 14 ADR. WDS(X22) IN 13
16800 SUB 14,-1(13) ;JX IN 14
16900 HRRZI 10,DPTR ; J=WDS(X+1)-WDS(X)
17000 ADDI 10,(12)
17100 MOVE 7,(10) ;WDS(X+1)
17200 SUB 7,-1(10) ;J IN 7
17300 MOVEM 7,MVBX ; STORE J
17400 SUB 7,14 ; Y=J-JX
17500 MOVE 14,-1(10) ; JX=WDS(X)+Y+1
17600 ADD 14,7
17700 AOJ 14, ; JX IN 14
17800 JUMPL 7,J2851 ; IF(Y)2851,182,282
17900 JUMPE 7,J182
18000 MOVE 15,(10) ;282 CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
18100 ADDI 15,2 ; ARG 1
18200 MOVE 6,-1(13) ; ARG 2
18300 JSA 16,LOOP
18400 JUMP 15
18500 JUMP 6
18600 JUMP [-1]
18700 JUMP 7 ; Y
18800 JUMP [0]
18900 JUMP DPY
19000 JRST J182 ; GO TO 182
19100 J2851: MOVE 14,(13) ;2851 CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
19200 ADD 14,7 ;+Y
19300 ADDI 14,1 ; ARG 1
19400 MOVE 5,-1(10) ;WDS(X)
19500 ADD 5,7
19600 ADDI 5,1 ; ARG 2
19700 MOVNM 7,MVBEAM ; -Y IS STORED
19800 JSA 16,LOOP
19900 JUMP 14
20000 JUMP 5
20100 JUMP [1]
20200 JUMP [0]
20300 JUMP MVBEAM
20400 JUMP DPY
20500 MOVE 14,-1(10) ; WDS(X) JX=WDS(X)+1
20600 ADDI 14,1 ; JX IN 14
20700 J182: MOVE 5,-1(13) ;182 CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
20800 ADDI 5,1 ;WDS(X22)+1
20900 JSA 16,LOOP
21000 JUMP [1]
21100 JUMP MVBX
21200 JUMP [1]
21300 JUMP 5
21400 JUMP 14
21500 JUMP DPY
21600 MOVE 2,DL ; DO 183 K=X22+1,X
21700 ; 183 WDS(K)=WDS(K)+Y
21800 HRRZI 3,PTR
21900 ADDI 3,(2)
22000 J183: JUMPE 11,J184 ;IF(Z.EQ.0)GO TO 184
22100 ADDM 11,(3) ; PWDS(K)=PWDS(K)+Z
22200 AOJ 3, ;UPDATE PWDS AND WDS
22300 J184: JUMPE 7,J185
22400 ADDM 7,(13)
22500 AOJ 13,
22600 J185: CAIGE 2,(12)
22700 AOJA 2,J183 ;ST(2)=WDS(X)
22800 MOVE 2,DPTR-1(12)
22900 MOVEM 2,DPY+1
23000 SETZM DL ;X22=0
23100 JRA 16,(16)
23200
23300 SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
23400 MOVEI 2,2 ;DIMENSION RPOS(2,200)
23500 S3: MOVE 6,2 ;(K=L HERE)
23600 SETO 11, ;L=2
23700 HRRZI 3,@(16) ;3 J=-1
23800 MOVE 4,2 ;RX=RPOS(1,L-1)
23900 SUBI 4,1 ;L-1
24000 IMULI 4,2
24100 ADDI 4,(3)
24200 MOVE 5,-2(4) ;RX
24300 S2: MOVE 7,6 ; DO 2 K=L,M
24400 ;IF(RPOS(1,K).GE.RX)GO TO 2
24500 IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
24600 ADDI 7,(3)
24700 CAMG 5,-2(7)
24800 JRST S1 ; CONTINUE
24900 MOVE 5,-2(7) ; RX=RPOS(1,K);;WHY WERE ALL THE RX'S JX ????? 9/6/73
25000 MOVE 11,6 ;J=K
25100 S1: CAMGE 6,@1(16) ;2 CONTINUE
25200 AOJA 6,S2
25300 JUMPL 11,S4 ;IF(J)GO TO 4
25400 MOVE 12,2 ;K=L-1
25500 SOS 12
25600 IMULI 12,2 ;(K*2)
25700 ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
25800 MOVE 10,-2(12)
25900 IMULI 11,2
26000 ADD 11,3
26100 EXCH 10,-2(11)
26200 MOVEM 10,-2(12)
26300 MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
26400 EXCH 10,-1(11)
26500 MOVEM 10,-1(12)
26600 S4: CAMGE 2,@1(16) ;4 L=L+1
26700 AOJA 2,S3 ;IF(L.LE.M)GO TO 3
26800 JRA 16,2(16) ;END
26900
27000 XNOTE: 0 ;FUNCTION XNOTE(J)
27100 MOVE 3,@(16) ;COMMON/XRN/RN(4000)
27200 IMULI 3,12 ;DIMENSION R(10,80)
27300 ;EQUIVALENCE (R,RN(3001))
27400 ;XNOTE=AMOD(R(4,J),100.)
27500 MOVE 2,RINP-7(3)
27600 JSA 16,AMOD
27700 JUMP 2
27800 JUMP [=100.0]
27900 CAML [80.0] ;IF(XNOTE.GE.80)XNOTE=XNOTE-100
28000 FSBR [100.0] ; FOR NEG. MINIS, ETC.
28100 MOVE 2,RINP-1(3) ;GET R(10,J)
28200 JUMPE 2,XJRA ;RETURN IF 0
28300 ;; MOVE 3,[5.0] ; ON STF ABOVE, +5 HGT.
28400 ;; CAMN 2,[1.0] ; 1=STF BELOW
28500 ;; MOVNS 3 ; MAKE IT -5
28600 ;; FADR 3 ;ADD IT TO XNOTE
28700 KIFIX 3,SCM+=80
28800 MOVE 4,STF(3) ;RSTFAC(STAFF)
28900 ADDI 3,POSI ;X=(THAT STAFF-THIS STAFF)/7.0
29000 MOVE 1,(3) ;THIS STAFF POS.
29100 AOJ 3, ;LOOK AT UPPER STAFF?
29200 CAMN 2,[1.0]
29300 SUBI 3,2 ;NO, LOOK AT LOWER
29400 FSBR 1,(3) ;MINUS THAT STAFF POS.
29500 ;X FADR 1,[123.0] ;+ BASIC DIFF. IN STAFF POS.
29600 ;X FMPR 1,STF+=8 ;* RSTJ2
29700 ;X FSBR 1,[123.0]
29800 FDVR 1,4 ;--OR-- XNOTE=(THIS-THAT)/(-7*RSTFAC(STAFF)
29900 FDVR 1,[-7.0] ; /-7.
30000 FADR 0,1
30100 XJRA: JRA 16,1(16) ;END
30200
30300 BAUTO: 0 ; SUBROUTINE BAUTO(J,L,K,N)
30400 ;C FOR AUTOMATIC BEAMS.
30500 MOVEI 2,2 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
30600 ADDB 2,@(16) ;J=J+2
30700 MOVE 4,@1(16)
30800 SUB 4,@3(16) ;L-N
30900 MOVE 5,@2(16)
31000 SUB 5,@3(16) ;K-N
31100 FLTR 4,4 ;TLC 4,232000
31200 MOVEM 4,SC+16(2) ;VX(J-1)=L-N
31300 ;**** A LIMIT OF 25 BEAMS PER LINE.
31400 FLTR 5,5 ;TLC 5,232000
31500 MOVEM 5,SC+17(2) ;VX(J)=K-N
31600 JRA 16,4(16)
31700
31800 UPDATE: 0 ; SUBROUTINE UPDATE(I)
31900 ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
32000 MOVE 3,LIMIT+3 ;RN(IS)=I
32100 FLTR 2,@(16) ;MOVE 2,@(16)
32200 MOVEM 2,XRN-1(3)
32300 ;IS=IS+I+3
32400 MOVE 2,@(16)
32500 ADDI 2,3
32600 ADDM 2,LIMIT+3
32700 JRA 16,1(16)
32800
32900 IK: 0 ;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
33000 JIT: 0 ; THESE ARE TO STORE PNTRS IN LOOP
33100 NEWR: 0 ; SUBROUTINE R
33200 MOVE A,SC+=70 ;GET THE MODE # ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
33300 CAIE A,1 ;COMMON/XRN/RN(4000)
33400 JRST N1 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
33500 MOVE JK,LIMIT+3 ;COMMON/SCX/JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
33600 MOVEM JK,IK ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
33700 MOVE JT,LIMIT+1 ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
33800 MOVEM JT,JIT ;DIMENSION R(10,80)
33900 N1: MOVE IS,IK ;EQUIVALENCE (R,RN(3001))
34000 MOVEM IS,LIMIT+3
34100 MOVE 14,[9999.0]
34200 MOVE JT,JIT ;IF(MODE.NE.1)GO TO 1
34300 ADDI JT,1 ;IK=IS
34400 MOVEM JT,LIMIT+1 ;HOMER=ITEM
34500 MOVEI K,=10 ;1 IS=IK
34600 MOVE IZ,SCX+=37 ;ITEM=HOMER+1 ******************** WAS +=33
34700 IMULI IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
34800 ;***N2: CAMN 14,RINP-3(K) ;IF(R(8,K).EQ.9999.)GO TO 2
34900 ;**** JRST NN2 ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
35000 N2: SETO IEND, ;C JUMP FOR BEAM CONT.
35100 ;IEND=-1
35200 MOVE A,SC+=70 ;PUT MODE NUM. INTO A
35300 MOVE IS,RINP-=10(K) ;GET CODE NUM. FROM R(1,K)
35400 CAMN IS,[1.0] ;IF IT IS 1, IEND=0
35500 JRST NX1 ;IF(MODE.NE.2)GO TO NX2
35600 CAMN IS,[2.0] ;IF(CODE IS NOT 2)GO TO NX2
35700 ;; CAME IS,[2.0] ;IF(CODE IS NOT 2)GO TO NX2
35800 ;; JRST NX2
35900 SKIPL RINP-5(K) ;IF(R(6,K).GE.0)GO TO NX2
36000 JRST NX2
36100 SKIPN RINP-4(K) ;IF(R(7,K).EQ.0)GO TO NN2 (DELETE IF INVIS. REST
36200 JRST NN2 ; AND NO RHYTHMIC VALUE.)
36300 SKIPA
36400 NX1: SETZ IEND,
36500 NX2: MOVE L,LIMIT+3 ;RN(IS+3)=0
36600 SETZM XRN+2(L) ;RN(IS+2)=0
36700 SETZM XRN+1(L)
36800 ;; SETZM LOOP ;LOOP=0 FOR P2→P11 TRANSFER
36900 MOVEI L,=10 ;C ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
37000 CAIL A,4 ;LK=10 IF(MODE.GT.3)L=7
37100 MOVEI L,8 ;ONLY LOOK AT 8 PARAMS AFTER MODE 3.
37200 N3: HRRZI R,RINP(K) ;DO 3 L=LK,1,-1
37300 ADDI R,(L) ;A=R(L,K)
37400 MOVE A,-13(R) ;(OCTAL) =13
37500 JUMPGE IEND,NX4 ;IF(A.NE.0)GO TO 77
37600 JUMPE A,NN3 ;IF(IEND)GO TO 3
37700 ;; JUMPN A,NX3 ;IF(IEND)GO TO 3
37800 ;; JRST NN3
37900 NX3: MOVE IEND,L ;77 IF(IEND)IEND=L
38000 NX4: MOVE R,LIMIT+3
38100 ADDI R,(L)
38200 MOVEM A,XRN-1(R) ;RN(IS+L)=A
38300 NN3: CAILE L,1 ;3 CONTINUE
38400 SOJA L,N3
38500 MOVE A,SCM+=80 ;A=STAFF #
38600 MOVEM A,XRN(R) ;PUT IT IN P2
38700 CAME IS,[1.0] ;IF NOT CODE 1, SKIP OVER
38800 JRST N4
38900 MOVEI IEND,=11 ;SET WDCNT
39000 MOVE A, RINP-9(K) ;GET WHAT'S IN R(2,K)
39100 MOVEM A,XRN+=9(R) ;PUT IT IN P11
39200 N4: CAIGE IEND,3 ;IF(LOOP.NE.0)RN(IS+11)=LOOP (REAL)
39300 MOVEI IEND,3
39400 MOVE 15,IEND ;IF(IEND.LT.3)IEND=3
39500 SUBI 15,2
39600 MOVE SC+=70 ;IF(A NOTE AND MODE.EQ.3)R(9,K)=PTR TO P11 OF NT.
39700 CAMN IS,[1.0]
39800 CAIE 3
39900 JRST NN4
40000 MOVE 0,R
40100 ADDI =10
40200 FLTR 0 ;USE THIS IN SLUR ROUTINE
40300 MOVEM RINP-2(K) ;R(9,K)
40400 NN4: JSA 16,UPDATE ;CALL UPDATE(IEND-2)
40500 JUMP 15
40600 NN2: CAML K,IZ ;2 CONTINUE
40700 JRA 16,(16) ;END
40800 ADDI K,=10
40900 JRST N2
41000
41100 RNX: 0 ;CALL RNX(A,B,C,D,E,F,G,H,I)
41200 MOVE 1,LIMIT+3 ;FILLS PARAMS 0→8 RN(IS+0)...RN(IS+8)
41300 MOVE @(16)
41400 MOVEM XRN-1(1) ;CALLED FROM 'BEAMS'
41500 MOVE @1(16)
41600 MOVEM XRN(1)
41700 MOVE @2(16)
41800 MOVEM XRN+1(1)
41900 MOVE @3(16)
42000 MOVEM XRN+2(1)
42100 MOVE @4(16)
42200 MOVEM XRN+3(1)
42300 MOVE @5(16)
42400 MOVEM XRN+4(1)
42500 MOVE @6(16)
42600 MOVEM XRN+5(1)
42700 MOVE @7(16)
42800 MOVEM XRN+6(1)
42900 MOVE @10(16)
43000 MOVEM XRN+7(1)
43100 JRA 16,11(16)
43200
43300 CNT: 0
43400 MSSLUP: 0
43500 SETZ 1, ;161 CNT=1
43600 SETZ 2,
43700 L5543: MOVE 3,.COMM.+4(2) ;DO 5543 K=1,10
43800 ;RA=RJQ(K)
43900 SKIPE 3 ;IF(RA.NE.0)CNT=K
44000 MOVE 1,2 ;5543 RJJ(K)=RA
44100 MOVEM 3,RRJJ+1(2)
44200 CAIG 2,=8 ; LOOP BACK?
44300 AOJA 2,L5543
44400 AOJ 1, ;********* WILL SAVE UP TO PARAM 12 ONLY!
44500 MOVEM 1,CNT ;REMEMBERS CNT
44600 JRA 16,(16)
44700
44800 LUP2: 0 ;261 RN(I)=CNT
44900 FLTR 2,CNT ;MOVE 2,CNT
45000 MOVE 1,LIMIT+3
45100 MOVEM 2,XRN-1(1)
45200 FLTR 2,.COMM.+1 ;MOVE 2,.COMM.+1 ;RN(I+1)=JA
45300 ;I=I+2
45400 MOVEM 2,XRN(1)
45500 MOVE 3,.COMM. ;RN(I)=R2
45600 MOVEM 3,XRN+1(1)
45700 MOVE 5,CNT ;DO 4554 K=1,CNT
45800 ADD 1,CNT
45900 ADDI 1,3
46000 MOVEM 1,LIMIT+3
46100 L4554: MOVE 2,.COMM.+3(5)
46200 MOVEM 2,XRN-2(1) ;4554 RN(I+K)=RJQ(K)
46300 SOJ 1,
46400 SOJG 5,L4554 ;3554 I=I+CNT+1
46500 JRA 16,(16)
46600
46700 ;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
46800 ;; SUBROUTINE HOMER
46900 ;; IMPLICIT INTEGER(A-Q,S-Z)
47000 ;; REAL PWDS,DISX,A,B,PLACE,STFF
47100 ;; COMMON /STF/RSTFAC(-3/4),RSTJ2
47200 ;; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
47300 ;; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
47400 ;; COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
47500 ;; EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
47600 ;; 1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
47700 ;; 1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
47800 HOMER: 0 ; IF(JA.EQ.6)GO TO 9
47900 MOVE MM,.COMM.+1
48000 CAIN MM,6
48100 JRST H9
48200 SKIPE .COMM.+=14 ;IF(R13.NE.0)GO TO 10
48300 JRST H10 ; FOR GENL HOMING; WORDS; BEAMS; STEMS;
48400
48500 ; ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
48600 ; NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
48700 JSA 16,HOMX
48800 JRA 16,(16)
48900
49000 H9: SKIPGE .COMM.+=32 ;9 IF(J11.LT.0)RETURN
49100 JRA 16,(16) ; IF P11=-1 NO HOMING
49200 MOVM R,.COMM.+=28 ; X=IABS(J7)/10 CC X=R7/10.
49300 IDIVI R,=10 ;;;FDVR R,[=10.0]
49400 ;; ********* NOW P10 CAN BE >100 SO NEXT CAN'T WORK SKIPN 2,.COMM.+=31 ;IF(J10.EQ.0)GO TO H100
49500 ;; JRST H100
49600 ;; CAIL 2,=10 ;IF(J10.GE.10)X=0 (=LOOK AT ALL STEM DIRS.)
49700 ;; SETZ R,
49800 H100: MOVEM R,XNOTE ;X SAVED IN XNOTE = STEM DIR. OF BEAM.
49900 ; R9= POS3
50000 ;XXX MOVNI RC,1 ;RC=-1
50100 ;XXX SKIPE .COMM.+=10 ;IF(R9.NE.0)RC=-2 ****OR .GT. *******
50200 ;XXX MOVNI RC,2
50300 ;??? MOVE .COMM.+=11 ;GET P10
50400 ;??? JUMPE H10 ;IGNORE IF 0
50500 ;CCC SKIPLE .COMM.+=8 ; SKIP IF R7 IS .LE.0
50600 ;CCC MOVNI RC,3 ; RC=0 ESCAPES FRCOM LOOP.
50700 ; HOMING RANGE FOR BEAMS
50800 H10: SKIPN NX,.COMM.+=12 ; 10 IF(R11.EQ.0)R11=2.9
50900 MOVE NX,[=2.9]
51000 MOVEM NX,.COMM.+=12 ; IF P11.NE.0 RANGE IS CHANGED FROM 2
51100 SETZ IZ,
51200 ;XXHX10: MOVE IZ,.COMM.+1 ; IF(JA.EQ.5)RC=-1
51300 HX10: MOVEI K,1
51400 SETZ RC,
51500 MOVE L,.COMM.+1 ; JA IS NOW IN L
51600 ;; CAIN L,5
51700 SUBI L,5 ;NOW JA=5 IS L=0
51800 SKIPN L
51900 SETO RC,
52000 H361: JSA 16,FINDIT ;DO 361 K=1,ITEM
52100 JUMP K
52200 JUMPL 0,HX361 ;IF(FINDIT(K))GO TO 361
52300 ; SKIPS NOTES ON WRONG LINE
52400 MOVEI R,XRN ;RD=RN(L+3)
52500 ADD R,LIMIT+2 ;LOC OF RN(L+1)
52600 MOVE A,2(R) ;RD IN A
52700 MOVEM A,RMOD+=9 ;1 IF(JA.NE.6)GO TO 177
52800 KIFIX JK,4(R) ;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
52900 IDIVI JK,=10 ;JK=NOTE'S STEM DIRECTION
53000 CAIE L,1 ;L=1 = JA=6
53100 ;; CAIE L,6
53200 JRST H177
53300 JUMPE JK,HX361 ;IF(RN(L+5).LT.10)GO TO HX361 (NO STEM)
53400 ;; SKIPN XNOTE ;IF(XNOTE.EQ.0)GO TO H177
53500 ;; JRST H177 ;XNOTE=0 = CHECK ALL STEM DIRS.
53600 CAMN JK,XNOTE ;ARE STEM DIR,S SAME?
53700 JRST H377 ;YES, JUMP
53800 MOVE -1(R)
53900 CAML [8.0]
54000 SKIPN JT, =9(R) ;JT='OTHER STAFF' INFO 2=↑ 1=↓
54100 SKIPA
54200 JRST HH377 ;IF(RN(L+10).EQ.0)GO TO H377
54300
54400 MOVE .COMM.+5 ;LEFT HEIGHT OF BEAM
54500 FADR .COMM.+6 ;RIGHT HEIGHT
54600 FDVR [2.0] ;AVERAGE HEIGHT OF BEAM
54700 FSBR 3(R) ;SUBTR HEIGHT OF NOTE
54800 CAIE JK,1 ;IF NOTE STEM DOWN, REVERSE SIGN
54900 MOVNS
55000 CAMG [8.0] ; IF DIFF. IS LESS THAN 8 DON'T HOOK BEAM TO STEM.
55100 JRST H377
55200
55500 HH377: MOVE 1,RNW ;RNW IS NOTE WIDTH( CURRENTLY =2.44)
55600 FMPR 1,STF+=8 ;*RSTJ2
55700 MOVM NN,.COMM.+=25 ;IF(ABS(J4.GE.100) *.6 (MINI)
55800 CAIL NN,=80
55850 CAIL NN,=180
55875 SKIPA ;IF(NN.LT.80.OR.NN.GE.180)THEN NOT A MINI
55900 FMPR 1,[0.6]
56000 CAIE JK,1
56100 MOVNS 1
56200 FADR A,1 ; ADD OR SUB. NOTE WIDTH FROM NOTE POS.
56300 JRST H177 ;ALL NOTES ON 'DIFF. STF' ARE CONSIDERED.
56400 H377: CAME JK,XNOTE
56500 JRST HX361
56600 H177: JSA 16,PLACE ;177 IF(PLACE(R3))GO TO 461
56700 JUMP .COMM.+4
56800 JUMPG HXX
56900 JUMPN L,H461 ; DO NEXT IF HOMING SLUR
57000 ;; CAIE L,5 ; DO NEXT IF HOMING SLUR
57100 ;; JRST H461
57200 JSA 16,PLACE ;ALSO CHECK FOR P6 (RT. END OF SLUR)
57300 JUMP .COMM.+7
57400 JUMPL H461 ; IF NEG. = DIDN'T FIND IN THAT AREA
57500 MOVEI .COMM.+7 ; GET LOC. OF P6
57600 SKIPA
57700 HXX: MOVEI .COMM.+4 ;LOC. OF P3
57800 MOVEM NX ;SAVE LOC. OF EITHER P3 OR P6
57900 SETO IZ,
58000 HX2: MOVE 5(R) ;GET PARAM 6
58100 CAMGE [10.0] ; MUST BE .GE.10
58200 JRST HX1
58300 MOVE IS,RNW ; SIZE OF A NOTE (NOW =2.44)
58400 CAML [20.0] ; 10 = RIGHT SHIFT, 20 = LEFT SHIFT
58500 MOVNS IS
58600 MOVM 3(R) ; GET P4
58700 CAML [80.0] ; IS IT A MINI?
58800 CAML [180.0]
58900 SKIPA
59000 FMPR IS,[0.6] ;*RMINI
59100 MOVE 1,.COMM.+3 ;STAFF #
59200 FMPR IS,STF(1) ;*RSTFAC(J2)
59300 FADR A,IS
59400 HX1: JUMPG IZ,HX8 ; JUMP TO CHANGE P6, 8 OR 9
59500 HX3: MOVEM A,(NX) ;R3=RD (OR R6)
59600 ;;HX3: MOVEM A,.COMM.+4 ;R3=RD
59700 ; LOOKS FOR NOTE, STAFF #, STEM DIR.
59800 MOVN .COMM.+=14 ;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
59900 SKIPG ;IS IT NEG.
60000 JRST H11 ; NO, GO TO NEXT SECTION.
60100 MOVEI JT,.COMM.+4 ;GET LOC. OF R3
60200 MOVE IS,3(R) ; VERTICAL POS OF NOTE (P4)
60300 CAME [1.0] ;IS P13 -1 OR -2?
60400 JRST H12 ;IT'S -2
60500 MOVE [2.0]
60600 ;; CAIE JK,2 ;WHICH WAY IS STEM? 2=STEM DOWN
60700 SKIPG .COMM.+=8 ;JUMP IF SLUR CURVES UP (STEMS DOWN) IN P7
60800 MOVNS ;ELSE MAKE DISPLACEMENT NEG.
60900 FADR IS ;ADD NOTE LEVEL
61000 ;; MOVEM .COMM.+5 ;P4=NOTE LEVEL + OR - 2.
61100 JRST HZ
61200 H12: MOVE IZ,7(R) ; STEM LENGTH
61300 CAMN IZ,[999.0] ; WHAT ABOUT 16TH AND 32ND NOTES??
61400 SETZ IZ,
61500 FADR IZ,[8.0]
61600 JSA 16,AMOD
61700 JUMP 6(R)
61800 JUMP [10.0] ;AC0=AMOD(R7,10.0)
61900 ;; SKIPN
62000 ;; JRST H13
62100 JUMPE H13
62200 FSBR [1.0] ;IGNORE 1ST TAIL
62300 FMPR [1.8] ; *SPACE FOR EACH TAIL
62400 H13: FADR IZ ; ADD TO STEM LENGTH
62500 CAIL JK,2 ; <2 = STEM UP
62600 MOVNS ;PUT IT UPSIDE DOWN.
62700 FADR IS ;ADD NOTE LEVEL
62800 ;; MOVEM IS,.COMM.+5 ;PUT IT BEYOND STEM
62900 HZ: CAME JT, NX ;ARE WE LOOKING AT R3 OR R6 (JT=R3)
63000 JRST .+3 ;JUMP FOR R6
63100 MOVEM .COMM.+5 ;PUT VERT. POS. INTO R4
63200 SKIPA
63300 MOVEM .COMM.+6 ;PUT VERT. POS. INTO R5
63400
63500 ;;H11: CAIN L,6 ;IF(JA.EQ.6)GO TO 861
63600 ;; JRST H861
63700 ;; CAIN L,5 ;IF(JA.EQ.5)GO TO 261
63800 ;; JRST HX361
63900 H11: CAIN L,1 ;IF(JA.EQ.6)GO TO 861
64000 JRST H861
64100 JUMPE L,HX361 ;IF(JA.EQ.5)GO TO 261
64200 JRA 16,(16) ;RETURN
64300 ;;H461: CAIN L,6 ;461 IF(JA.EQ.6)GO TO 277
64400 ;; JRST H277
64500 ;; CAIE L,5 ;IF(JA.NE.5)GO TO 361
64600 ;; JRST HX361
64700 H461: CAIE L,1 ;461 IF(JA.EQ.6)GO TO 277
64800 JUMPN L,HX361 ;IF(JA.NE.5)GO TO 361
64900 H277: JSA 16,PLACE ;277 IF(PLACE(R6))GO TO 561
65000 JUMP .COMM.+7
65100 JUMPL H561
65200 MOVEI IZ,7 ;R6=RD
65300 JRST HX2
65400 H861: MOVE 0,.COMM.+=28 ;861 IF(J7.GE.0)GO TO 261
65500 JUMPGE 0,HX361
65600 H561: MOVE .COMM.+=10 ;IF(R9.LE.0)GO TO 661
65700 JUMPLE H661
65800 JSA 16,PLACE ;561 IF(PLACE(R9))GO TO 661
65900 JUMP .COMM.+=10 ;R9
66000 JUMPL H661
66100 SKIPL .COMM.+=28 ;IF(J7)GO TO 761 J7=NEG MEANS TREMOLO
66200 SKIPE .COMM.+=9 ; IF(R8.NE.0)GO TO 761
66300 JRST H761
66400 ;; MOVE 0,.COMM.+=28 ;IF(J7)GO TO 761
66500 ;; JUMPL H761 ; J7=NEG MEANS TREMOLO
66600 ;; MOVE 0,.COMM.+=9 ; IF(R8.NE.0)GO TO 761
66700 ;; JUMPN H761
66800 MOVE 0,.COMM.+=11 ; IF(R10.EQ.0)GO TO 361
66900 JUMPE HX361
67000 H761: MOVEI IZ,=10 ;761 R9=RD
67100 JRST HX2
67200 ; R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM. ; GO TO 261
67300 ;;H661: CAIN L,5 ;661 IF(JA.EQ.5)GO TO 361
67400 ;; JRST HX361
67500 H661: JUMPE L,HX361 ;661 IF(JA.EQ.5)GO TO 361 L=1 = JA=5
67600 ;; MOVE 0,.COMM.+=31 ;IF(J10.LT.30)GO TO 361
67700 ;; CAIGE 0,=30
67800 SKIPN .COMM.+=31 ;IF J10.EQ.0 GO TO 361
67900 JRST HX361
68000 JSA 16,PLACE ;IF(PLACE(R8))GO TO 361
68100 JUMP .COMM.+=9
68200 JUMPL HX361 ; HOMES INNER PARTIAL BEAMS
68300 MOVEI IZ,=9 ;R8=RD
68400 JRST HX2
68500 HX8: MOVEM A,.COMM.(IZ) ;PUT A INTO RIGHT PARAM.
68600 ;XXXH261: SKIPN RC ;261 IF(RC.EQ.0)RETURN
68700 ;XXX AOJ RC ;RC=RC+1
68800 HX361: CAMGE K,LIMIT+1 ;361 CONTINUE
68900 AOJA K,H361
69000 JRA 16,(16) ; END
69100
69200 ;;PFIBX: 0 ;DATA FIB/0.618/, RFIB/-.382/,ALG/0.6931472/
69300 ;100 ACCEPT 10,A 10 FORMAT(F)
69400 ;; MOVE 12,@(16) ;PFIBX=14
69500 ;; MOVE 13,[14.0] ;IF(A.EQ.1)GO TO 20
69600 ;; CAMN 12,[1.0] ;Z=FIB
69700 ;; JRST PFX ;IF(A.LT.1)Z=RFIB
69800 ;; JSA 16,ALOG ;RH=ABS(ALOG(A)/ALOG(2.0))
69900 ;; JUMP 12
70000 ;; FDVR 0,[0.6931472] ;ALOG(2.0)
70100 ;; MOVM 11,0
70200 ;; MOVE 10,[0.618] ;FIB FACTOR
70300 ;; SKIPG ;L=RH
70400 ;; MOVN 10,[0.382] ;IF(L.EQ.0)GO TO 4
70500 ;; KIFIX 7,11
70600 ;; MOVE 6,7 ;SAVE L FOR LATER
70700 ;; JUMPE 6,PFZ
70800 ;;PF: MOVE 2,13 ; DO 3 K=1,L
70900 ;; FMPR 2,10 ;3 PFIBX=PFIBX+PFIBX*Z
71000 ;; FADR 13,2
71100 ;; SOJG 6,PF
71200 ;;PFZ: FLTR 7,7 ;4 RH=RH-L
71300 ;; FSBR 11,7 ;IF(RH.EQ.0)GO TO 20
71400 ;; JUMPE 11,PFX
71500 ;; MOVE 2,13
71600 ;; FMPR 2,10
71700 ;; FMPR 2,11 ;PFIBX=PFIBX+PFIBX*Z*RH
71800 ;; FADR 13,2
71900 ;;PFX: MOVE 0,13 ;SEND BACK THE RESULT
72000 ;; JRA 16,1(16)
72100
72200 CODN: 0 ;FUNCTION CODN(K,N)
72300 MOVE 1,@(16) ;GET CODE NUMBER AND RETURN POINTER
72400 MOVE 2,PTR-1(1) ;L=KWDS(K)
72500 MOVEM 2,@1(16)
72600 MOVE XRN(2) ;CODN=RN(L+1)
72700 JRA 16,2(16)
72800
72900 FSCAN: 0
73000 INCHRW
73100 MOVE 2,[ASCII/ /]
73200 MOVEM 2,ALF
73300 MOVE 2,[XWD ALF,ALF+1]
73400 BLT 2,ALF+=71 ; CLEANS OUT INP ARRAY
73500 CAIN ";"
73600 JRA 16,(16)
73700 CAIN ":"
73800 JRA 16,1(16)
73900 CAIN "("
74000 JRA 16,2(16)
74100 CAIN ")"
74200 JRA 16,3(16)
74300 CAIN "/"
74400 JRA 16,4(16)
74500 CAIN "*"
74600 JRA 16,5(16)
74700 CAIN "X"
74800 JRA 16,6(16)
74900 CAIN "C"
75000 JRA 16,7(16)
75100 JRA 16,8(16)
75200
75300
75400 NALF: 0
75500 MOVE 0,@(16)
75600 JUMPGE .+4 ;IF(I.GE.0)GO TO 20
75700 MOVE 1,[405004020100] ; J='A'=405004020100
75800 SETO 2, ; M=-1
75900 JRST .+3 ;GO TO 10
76000 MOVE 1,[201004020100] ;20 J=' '=201004020100
76100 MOVEI 2,=16 ; M=16
76200 SUB 0,1 ;10 NALF=(I-J)/536870912-M
76300 IDIV 0,[3777777777]
76400 SUB 0,2
76500 JRA 16,1(16)
76600
76700 BOX: 0 ;CALL BOX(I,R) SEE PLTSRT.F4 FOR FORTR. VERSION
76800 MOVE IDEV
76900 CAIE 5
77000 JRA 16,2(16) ;IF(IDEV.NE.5)RETURN
77100 MOVE 14,@(16) ; I IS IN 14
77200 JUMPL 14,BX4
77300 KIFIX 13,@1(16) ;K=R ;MOVE 13,@1(16) ; GET R
77400 JSA 16,AMOD
77500 JUMP XRN+3(14) ; GET REAL P4
77600 [100.0]
77700 CAMGE [-20.0] ;IF(P4.LT.-20)P4=P4+100
77800 FADR [100.0] ; FOR P4=-95 ETC.
77900 CAML [80.0] ;IF(P4.GE.80)P4=P4-100
78000 FSBR [100.0] ; CATCHES NEG. MINIS, ETC.
78100 FMPR [7.0]
78200 FMPR STF(13) ;*STAFF FACTOR
78300 FADR POSI(13) ; + STAFF VERT. POS.
78400 FSBR [40.0] ; SHIFT CURSOR DOWN A BIT.
78500 FMPR SIZ
78600 KIFIX 13,0
78700 SUB 13,SIZ+2 ;13=K
78800 JSA 16,RHORZ ; GET HORIZ. POS.
78900 JUMP XRN+2(14)
79000 FMPR SIZ ;SIZ IS FOR ZOOMED IMAGES
79100 KIFIX 12,0 ;MOVE 12, ; 12=L
79200 SUB 12,SIZ+1
79300 CAIL 12,=550 ; CHECK IF OUT OF BOUNDS OF CRT
79400 MOVEI 12,=511
79500 CAMG 12,[-=550]
79600 MOVE 12,[-=511]
79700 JSA 16,SETCUR
79800 12
79900 13
80000 [0]
80100 MOVE DL ;IOLD=X22 FOR TYPING "I <CR>" TO GET LAST EDIT BACK.
80200 MOVEM DL+4
80300 JRA 16,2(16) ; THE CURSOR IS IN POSITION
80400 BX4: CAME 14,[-1]
80500 JRST BX5
80600 JSA 16,DPYSET
80700 [3]
80800 RINP
80900 [=100]
81000 JSA 16,DPYBRT
81100 [3]
81200 BX5: MOVE 2,@1(16) ; GET R
81300 JSA 16,RHORZ
81400 2
81500 FMPR SIZ
81600 KIFIX 0,0
81700 SUB SIZ+1
81800 MOVM 2,
81900 CAILE 2,=550
82000 JRST BX6
82100 MOVEM 0,LOOP
82200 JSA 16,SETPOG
82300 [3]
82400 JSA 16,ALINE
82500 LOOP
82600 [-=511]
82700 LOOP
82800 [=511]
82900 JSA 16,DPYOUT
83000 [3]
83100 BX6: JSA 16,SETPOG
83200 [1]
83300 JRA 16,2(16)
83400
83500 PARCH: 0 ;CALL PARCH(JA,JJA,RD)
83600 MOVE 2,@(16) ;GET JA
83700 CAIN 2,2 ;IS IT P2
83800 JRST .+8
83900 CAIE 2,1 ;IS IT P1
84000 JRA 16,3(16) ;NEITHER
84100 KIFIX 3,@2(16) ;GET RD
84200 JUMPE 3,.+3 ; REJECTS CODE # 0.
84300 CAIG 3,=18 ;IS PARAM .GT.18?
84400 MOVEM 3,@1(16) ;PUT IT INTO JJA
84500 JRA 16,3(16) ;ALL DONE
84600 MOVE 3,@2(16) ;GET RD
84700 CAMG 3,[7.0] ;REJECTS STAFF # .GT.7
84800 MOVEM 3,RRJJ ; PUT IT AWAY
84900 JRA 16,3(16)
85000
85100 RCURVE: 0 ; R7=RCURVE(R3)
85200 MOVE 2,(16) ; R7=0.9+(R6-R3)/25.+ABS(R4-R5)/10.
85300 MOVE 1,3(2)
85400 FSBR 1,(2) ;R6-R3
85500 MOVE 3,5(2) ;IF(R8.LT.-1)Z=Z+R8*2.
85600 FADR 3,[1.0]
85700 JUMPGE 3,RCRV ;R8=-2=BETWEEN NOTES, =-3=1ST NOTE IS DOTTED.
85800 FADR 3,3
85900 FADR 1,3
86000 RCRV: FDVR 1,[25.0] ; /25.
86100 MOVE 0,2(2)
86200 FSBR 0,1(2) ;R5-R4
86300 MOVMS ;ABSOLUTE VALUE
86400 FDVR 0,[10.0] ; /10.
86500 FADR 0,1
86600 FADR 0,[0.9] ; +.9
86700 SKIPGE 4(2) ;IF(R7 WAS .LT.0)KEEP IT NEGATIVE.
86800 MOVNS
86900 JRA 16,1(16)
87000
87100 RJED: 0 ;6222 DO 1222 K=1,20,2
87200 MOVEI 1,1
87300 RJ1: SKIPN .COMM.+=23(1)
87400 JRA 16,(16)
87500 MOVE 4,.COMM.+=23(1) ;L=JQ(K)
87600 ;IF(L.EQ.0)GO TO 6221
87700 ; '600 2' WILL ADD 2 TO PARAM 6. '3000 6' SETS P3=P6.
87800 MOVE 5,.COMM.+4(1) ;RD=RJQ(K+1)
87900 MOVE 6,4 ;X=L
88000 CAIGE 4,=100 ;IF(L.LT.100)GO TO 223
88100 JRST RJ223
88200 CAIGE 4,=2000 ;IF(L.LT.2000)GO TO 5223
88300 JRST RJ5223
88400 IDIVI 6,=1000 ;X=L/1000
88500 MOVE 4,.COMM.+=24(1) ;L=JQ(K+1)-2
88600 SUBI 4,2
88700 MOVE 5,RRJJ(4) ;RD=RJJ(L)
88800 JRST RJ2223 ;GO TO 2223
88900 RJ5223: IDIVI 6,=100 ;5223 X=L/100
89000 CAIN 6,2 ;IF(X.EQ.2)GO TO 1223
89100 JRST RJ1223
89200 FADR 5,RRJJ-2(6) ;RD=RJJ(X-2)+RD
89300 JRST RJ2223 ;GO TO 2223
89400 RJ1223: FADR 5,RRJJ ;1223 RD=RJJ2+RD
89500 RJ223: CAIG 6,2 ;223 IF(X.LE.2)GO TO 3223
89600 JRST RJ3223
89700 RJ2223: MOVEM 5,RRJJ-2(6) ;2223 RJJ(X-2)=RD
89800 JRST RJ1222 ;GO TO 1222
89900 RJ3223: JSA 16,PARCH ;3223 CALL PARCH(X,JJA,RD)
90000 6 ; NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
90100 RRJJ+21
90200 5
90300 RJ1222: ADDI 1,2
90400 CAIG 1,=20 ;1222 CONTINUE
90500 JRST RJ1 ;*** LOOP SET TO 20(20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
90600 JRA 16,(16)
90700
90800 RJED2: 0
90900 MOVEI 1,=11 ;6221 DO 5514 K=1,11
91000 RJ6221: MOVE 3,RRJJ(1) ;R2=RJJ(K)
91100 MOVEM 3,.COMM.+3(1) ;RJQ(K)=R2
91200 KIFIX 3,3
91300 MOVEM 3,.COMM.+=23(1) ;5514 JQ(K)=R2
91400 SOJG 1,RJ6221
91500 MOVE RRJJ ;R2=RJJ2
91600 MOVEM .COMM.
91700 MOVE RRJJ+=21 ;JA=JJA
91800 MOVEM .COMM.+1
91900 SOS LIMIT+1 ;ITEM=ITEM-1
92000 SKIPGE LIMIT+1 ;IF(ITEM)ITEM=0
92100 SETZM LIMIT+1
92200 JRA 16,(16)
92300
92400 EDX: 0 ;FUNCTION EDX(RLINE)
92500 MOVE 2,JCHAR+4 ;AC2=JED
92600 CAMLE 2,LIMIT+1 ;244 X=ITEM
92700 JRST E444 ;IF(JED.GT.X)GO TO 444
92800 MOVE 6,.COMM.+1 ;AC6=JA
92900 MOVE 4,JCHAR+6 ;AC4=REDIT
93000 MOVE 3,JCHAR+5 ;AC3=KED
93100 MOVE 5,JCHAR+7 ;AC5=RITEM
93200 SETZ 7, ;FLAG FOR '33' FEATURE
93300 CAME 5,[33.0] ;IF CODE NUM 33 IS TYPED IT MEANS ALL THINGS
93400 CAMN 5,[44.0] ;USE 44 FOR NON-BARLINES IN CODE 4
93500 SKIPA
93600 JRST EDZ ;UNDER CODE 3 EXCEPT P5=0,1,2,3,4,5 (REAL CLEFS)
93700 SETO 7,
93800 FDVR 5,[11.0] ;CHANGE 33,44 BACK TO 3,4
93900 EDZ: MOVE 1,PTR-1(2) ; DO 144 K=JED,X
94000 CAMN 3,[-2] ;L=PWDS(K)
94100 JRST E654 ;IF(KED.EQ.-2)GO TO 654
94200 ; -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
94300 CAIN 3,2 ;IF(KED.EQ.2)GO TO 656
94400 JRST E656
94500 CAME 4,XRN+1(1) ;IF(RN(L+2).NE.REDIT)GO TO 144
94600 JRST E144
94700 JUMPL 3,E654 ;IF(KED)GO TO 654
94800 JUMPE 5,E655 ;IF(RITEM.EQ.0)GO TO 655
94900 E656: CAME 5,XRN(1) ;656 IF(RITEM.NE.RN(L+1))GO TO 144
95000 JRST E144
95100 JUMPE 7,E655 ;SKIP NEXT UNLESS '33,44' FLAG IS SET (AC7=-1)
95200 MOVE XRN-1(1) ;IF(RN(L).EQ.1)GO TO 144 (TREBLE CLEF)
95300 CAMG [2.0]
95400 JRST E144
95500 CAMN 5,[4.0] ;IF(RITEM.EQ.4)GO TO 655
95600 JRST E655 ;JUMP IF WDCNT OF CODE 4 .GT.2
95700 MOVE XRN+4(1) ;IF(RN(L+5).LE.5)GO TO 144 (SOME REAL CLEF)
95800 CAMG [5.0]
95900 JRST E144
96000 E655: CAIE 6,=55 ;655 IF(JA.NE.55)GO TO 344
96100 JRST E344
96200 E654: MOVE @(16) ;654 IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
96300 FSBR XRN+2(1)
96400 MOVMS
96500 CAMGE [5.0]
96600 JRST E344
96700 E144: CAMGE 2,LIMIT+1 ;144 CONTINUE
96800 AOJA 2,EDZ
96900 E444: MOVE [999.0] ;444 REDIT=999.
97000 MOVEM JCHAR+6 ;C NO MORE ON LINE
97100 SETZM .COMM. ;R2=0
97200 ; SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
97300 JRA 16,1(16) ;GO TO 73
97400 E344: MOVEM 2,DL ;344 JED=K+1
97500 AOJ 2, ;C FOR NEXT TIME AROUND
97600 MOVEM 2,JCHAR+4
97700 SETO ;X22=K
97800 JRA 16,1(16) ;AC0=-1=GO TO 429, =>0=GO TO 73
97900
98000 EQUAL: 0 ;CALL EQUAL
98100 MOVE 2,.COMM.+1 ;IF(JA.LE.13)GO TO 324
98200 CAIG 2,=13
98300 JRST EQ324
98400 IDIVI 2,=10 ;JA=JA/10
98500 ; ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
98600 KIFIX 3,.COMM. ; X=R2-2.
98700 MOVE RRJJ-2(3) ;RJJ(JA-2)=RJJ(X)
98800 MOVEM RRJJ-2(2)
98900 JRA 16,1(16) ;GO TO 6222
99000 EQ324: MOVE .COMM. ;GET R2
99100 SKIPGE @(16) ;(X) 324 I1=JA-2
99200 JRST EQ224 ;IF(X)GO TO 224
99300 MOVEM RRJJ-2(2) ;RJJ(I1)=R2
99400 JRA 16,1(16) ;GO TO 6222
99500 EQ224: FADRM RRJJ-2(2) ;224 RJJ(I1)=RJJ(I1)+R2
99600 JRA 16,1(16)
99700
99800
99900 BOXX: 0 ;CALL BOXX
00100 MOVE LIMIT+3 ;429 IX=I
00200 MOVEM LIMIT+4
00300 MOVE 1,DL ; MEDIT=PWDS(X22)
00400 MOVE 1,PTR-1(1)
00500 MOVEM 1,DPY+=4000
00600 ;; MOVEI 2,2 ; J=2
00700 KIFIX 3,XRN-1(1) ;;426 Y=RN(MEDIT)+J
00800 ADDI 3,2
00900 MOVEM 3,EQUAL ; EQUAL IS 'Y'
01000 JSA 16,LOOP ; CALL LOOP(0,Y,1,I,MEDIT,RN)
01100 [0]
01200 EQUAL
01300 [1]
01400 LIMIT+3
01500 DPY+=4000
01600 XRN
01700 MOVE 3,LIMIT+3 ; JJA=RN(I+1)
01800 KIFIX 3,XRN(3)
01900 MOVEM 3,RRJJ+=21
02000 MOVE EQUAL ; YED=Y-2
02100 SUBI 2
02200 MOVEM YED
02300 MOVE 1,LIMIT+3 ; L=I+2
02400 ADDI 1,2
02500 MOVE 3,1 ;AC3=K+L-1
02600 MOVEI 2,1 ; AC2 = K
02700 BXX: CAMLE 2,YED ; DO 422 K=1,11
02800 JRST BX423 ; IF(K.GT.YED)GO TO 423
02900 MOVE XRN(3) ; RJJ(K)=RN(L+K)
03000 MOVEM RRJJ(2)
03100 JRST BX422 ; GO TO 422
03200 BX423: SETZM RRJJ(2) ;423 RJJ(K)=0
03300 BX422: AOJ 3, ; UPDATE K+L-1
03400 CAIGE 2,=11 ;422 CONTINUE
03500 AOJA 2,BXX
03600 MOVE XRN-1(1) ; RJJ2=RN(L)
03700 MOVEM RRJJ
03800 SKIPLE DPY+=4001 ; IF(IGO.GT.0)GO TO 4231
03900 JRST BX4231 ; NO BOX WHEN IN GROUP EDIT ROUTINE
04000 MOVEM YED+2 ; RBOX=RJJ2
04100 MOVE LIMIT+3 ; IBOX=I
04200 MOVEM YED+1
04300 JSA 16,BOX ; CALL BOX(IBOX,RBOX)
04400 YED+1
04500 YED+2
04600 BX4231: AOS LIMIT+1 ;4231 ITEM=ITEM+1
04700 MOVE 1,LIMIT+1
04800 MOVE DPTR-1(1) ; ST2=WDS(ITEM)
04900 JRA 16,(16) ; RETURN
05000
05100 END